home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 18
/
CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso
/
CUCD
/
Programming
/
ARexxGuide
/
ARx_IactExamples.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-04-02
|
20KB
|
495 lines
/* $VER: 1.2 ARx_IactExamples by Robin Evans (8 Jul 1993,15 Oct 1993,11,20 Mar 1994)
** v1.1: Added '+' to numbers in Numeric demo to un-exponent them **
** v1.2: Added showvalidsymbol which was left out the orig. guide. */
foo = address()
address REXX
call trace 'B'
call addlib('rexxsupport.library',0,-30,0)
/* My thanks to Tom Miller on GEnie for pointing out this elegant **
** way to redirect output and input to a new window */
arg SubR .
/* set up various formatting codes in compound variables that **
** can be exposed to subroutines by using just the stem */
csi='9b'x;f.slant=csi'3m'; f.bold=csi'1m'; f.norm=csi'0m'
f.black=csi'31m'; f.white=csi'32m'; f.blue=csi'33m'
f.lf = '0a'x; f.cls = csi'0;0H'csi'J'
options prompt f.white':::' f.norm
/* Create a new standard-I/O console, so that we can use say **
** and pull instead of writeln() and readln() for output and **
** input. Note: the { system "rx.."} used in the AG link is **
** there because this setup won't work when AG is called by icon **
** unless that kludge is there. Using AG's RX command, the input **
** stream isn't opened under a workbench call */
call close STDOUT
if open(STDOUT, "con:98/8/584/345/ARexxGuide Examples/NOCLOSE/SCREEN *", w) then do
call close STDIN
call open STDIN, "*", W
call pragma '*' STDOUT
call pragma '*' STDIN
/* for some odd reason, the Amiga shell won't reliably call an **
** external function when at the default Amigaguide address */
address REXX
interpret 'call' SubR 'CLOSE'
call close STDOUT
call close STDIN
call pragma('*')
return 0
address
end
else
signal error
SYNTAX:
ErrCo = rc
ERROR:
signal off SYNTAX /* to prevent any possibility of an endless loop */
say '0a'x
say 'Sorry, an unexpected error has occurred in line' SIGL
if datatype(ErrCo, 'N') then
say ' 'ErrCo':' errortext(ErrCo)
call delay(1000)
push endcli
exit 9
/* $VER: 1.0 ShowNumeric.rexx by Robin Evans (21 May 1993) */
ShowNumeric: procedure expose f.
/* Demonstrate the effect of different settings of NUMERIC DIGITS
** and NUMERIC FUZZ
*/
arg CLOSE
options failat 21 /* to retain control when an error occurs */
signal on ERROR
signal on SYNTAX
say f.white||' This example will demonstrate how different settings of'
say ' 'f.black'NUMERIC DIGITS'f.white 'and' f.black'NUMERIC FUZZ'f.white 'affect the comparison'
say ' of numeric values.'||'0a'x
say ' Enter two numbers separated by at least one space, then'
say ' press <'f.blue||f.bold'Enter'f.norm'>.'
say f.lf||f.black'To quit, press <'f.blue||f.bold'Q'f.norm'> and <'f.blue||f.bold'Enter'f.norm'>.'f.lf
do MainLoop = 1 /* exits on the datatype() check 4 lines down */
say f.lf||f.blue'Enter two numbers to be compared:'
pull Num.1 Num.2 .
do i = 1 to 2
/* any non-numeric value (including null) causes an exit from
** the main loop above.
*/
Num.i = compress(Num.i, ',')
if ~datatype(Num.i,N) then do
if ~abbrev(upper(Num.i), 'Q') then do
say 'You must enter two numbers.'f.white ' <Enter' f.blue'Q'f.white 'to quit>'f.black
iterate MainLoop
end
else
leave MainLoop
end
/* a decimal point is not considered part of a number's length */
Num.i.len = length(compress(+Num.i,'.'))
end
MNum = max(num.1, num.2)
XLen = max(num.1.len, num.2.len)
numeric digits min(XLen, 14)
if XLen > 14 then do
say f.white'The greatest precision available in ARexx is 14 digits.'
say 'The number you entered with' XLen 'digits would always'
say 'be rounded to the closest 14-digit value:'||f.norm
/*
** the prefix + sign causes MNum to be evaluated according to the
** current digits() setting
*/
say ' ' (+MNum) '0a'x
XLen = 14
end
NLen = min(num.1.len, num.2.len)
/* begin with a setting that will handle the largest number entered */
/* if the numbers are equal under the most precise setting, then
** they will be equal under any other setting as well
*/
if num.1 = num.2 then do
say (+num.1) 'will always be equal in any comparison to' (+num.2)
call ShowImprecise
end
else do
numeric fuzz digits() - 1
/*
check for equality under the least precise setting and then
find out the most precise setting at which the two are equal
*/
if num.1 = num.2 then do
numeric fuzz /* reset to make the first comparison at 0 */
do i=0 to XLen-1 while num.1 ~= num.2
numeric fuzz i
end
if num.1 = num.2 then do
say (+num.1) 'is considered equal to' (+num.2) 'under these conditions:'
say ' DIGITS setting of' digits()
say ' FUZZ setting of' fuzz()
say ' or at a FUZZ setting of 0 and DIGITS setting of' digits() - fuzz()
numeric fuzz
say f.white' The following table shows how the numbers are presented'
say ' under different settings of NUMERIC DIGITS.'
say ' Digits() 'left(Num.1,18) (Num.2)
say f.blue' --------- ------------------ ------------------'f.norm
do j = max(1,digits()-i) to xlen until strip(MNum) == (+MNum)
numeric digits j
say ' 'center(digits(),11) left((+Num.1),18) (+Num.2)
end
end
end
else do
say max((+num.1), (+num.2)) 'will always be considered greater than' min((+num.1), (+num.2))
call ShowImprecise
end
end
numeric fuzz
numeric digits
end
if close = 'CLOSE' then
push endcli
return 0
ShowImprecise:
say f.white' The following chart shows the two numbers under the'
say ' most imprecise settings of NUMERIC DIGITS 1 and 2'
say ' 'left(+Num.1,15) (+Num.2)
say f.blue' -------------- --------------'f.norm
numeric fuzz
numeric digits 1
say ' 'left((+Num.1),15) (+Num.2)
numeric digits 2
say ' 'left((+Num.1),15) (+Num.2)||f.norm
return
/* $VER: 1.1 ShowValidSymbol (20 Mar 1994) */
ShowValidSymbol: procedure expose f.
call addlib('amigaguide.library',-2,-30,0)
if ~loadxref('ARx_Guide.xref') then CheckXR = 0
else CheckXR = 1
LineLen = 62; Tab = 3 /* Values for wordwrap function */
/* Tests whether a value input by the user is a valid symbol */
say WordWrap("This demonstration lets you enter a string of any kind. The",
"program will tell you if the string could be used as a valid",
f.white"symbol" f.black"in ARexx. Some symbols can serve as" f.white"variables"f.black"; some",
"cannot. The program will tell you whether the string you",
"entered is a" f.white"variable symbol"f.black "or a" f.white"constant"f.black".",,
LineLen, 6)
ValidChars = xrange('a','z')xrange('A','Z')xrange(0,9)
Info = '0a'x||f.white'Enter a string or press <'f.blue||f.bold'Enter'f.norm||f.white'> alone to quit.'
options Prompt f.white'::: 'f.black
do forever
Say Info
pull Resp
if Resp = '' then leave
if ~datatype(resp, 'S') then do
say '0a'x||f.white||Resp f.blue'in not a valid symbol in ARexx'f.black
BadPos = verify(Resp, ValidChars'$_.!@#')
say WordWrap("The character at position" BadPos "--"f.bold||f.white||substr(resp,BadPos,1)f.norm"-- in the string is invalid.",
"Any of the characters `"f.white"a"f.black"' through `"f.white"z"f.black"' or `"f.white"A"f.black"' through `"f.white"Z"f.black"',",
"or the digits `"f.white"0"f.black"' through `"f.white"9"f.black"' can be used.",
"You can also use any of these special characters:"f.white "$_!@#"f.black,
"The period character `"f.white"."f.black"' can be used, but it has special",
"significance.", LineLen, Tab)
end
else do
say '0a'x||f.white||Resp f.blue'is a valid symbol.'f.black
select
when datatype(resp,'N') then do
say WordWrap("Since it's a "f.white"number"f.black", it's what is known as a" f.white"constant",
"symbol"f.black". This symbol can be used in any" f.white"arithmetic operation"f.black,
"but it cannot be used as the target of an" f.white"assignment"f.black".",,
LineLen, Tab)
if pos('E', resp) > 0 then do
numeric digits 14; numeric form scientific; stdnum = (+resp)
numeric digits length(compress(left(resp,pos('E', resp)),'E.'))
scinum = (+resp)
numeric form engineering; engnum = (+resp)
if SciNum == StdNum then NumCompare = '.'
else if SciNum == EngNum then
NumCompare = " or as"f.white SciNum f.black"in both scientific",
"and engineering notation."
else
NumCompare = ", as"f.white SciNum f.black"in scientific",
"notation, or as"f.white EngNum f.black"in engineering notation."
say WordWrap('0a'x" The `"f.white"E"f.black"' in this string represents" f.white"exponential notation"f.black".",
"The number can be expressed as"f.white StdNum f.black"in the highest",
"precision available in ARexx" || NumCompare,,
LineLen, Tab)
numeric digits; numeric form scientific
end
else do
NumLen = length(compress(strip(resp,'L',0),'.'))
if NumLen > 9 then do
say WordWrap('0a'x" A" NumLen"-digit number is longer than what can be handled with the",
"default 9-digit" f.white"precision"f.black "of ARexx. If this number were used in an",
"an arithmetic operation, it would be rounded to" (+Resp)".",,
LineLen, Tab)
if NumLen > 14 then do
numeric digits 14
say WordWrap('0a'x" The maximum precision in ARexx is 14 digits, so the closest value",
"that is available is" (+Resp)".", LineLen, Tab)
end
else do
numeric digits NumLen
say WordWrap('0a'x" If the digits setting is increased to" NumLen "with the" f.white"NUMERIC DIGITS"f.black,
"instruction, then the number will be expanded to" (+resp)".",,
LineLen, Tab)
end
numeric digits
end
end
end
when datatype(left(Resp, 1), 'N') then do
say WordWrap("This is a `"f.white"constant symbol"f.black"' because of the digit at the",
"beginning. It cannot be used as the target of an",
"assignment. Because of the alphabetic characters in",
"the symbol, it cannot be used as a" f.white"number"f.black".",
"It may, however, be used as the logical "f.slant"<name>"f.norm" of a file",
"in OPEN(<name>, <filename>, <opt>).", LineLen, Tab)
if pos('.', resp) > 0 then do
say WordWrap('0a'x" Despite the dot -- `.' -- at position" pos('.', resp) "in"f.white Resp||f.black", this",
"symbol cannot be used as a"f.white "compound variable"f.black "because",
"the"f.white "stem"f.black "of a compound cannot be a" f.white"constant"f.black".",,
LineLen, Tab)
end
else do
say WordWrap('0a'x" It could also be used as a value in the" f.white"tail"f.black "of a",
f.white"compound variable"f.black". (Something like" f.white"FOO."resp||f.black".) Using",
"a" f.white"constant"f.black "as a tail value assures that another value",
"will not be substituted before the variable is evaluated.",,
LineLen, Tab)
end
end
when verify(Resp, ValidChars'$_!@#') = 0 then do
say WordWrap("This is a `"f.white"simple symbol"f.black"' that can be used as the name of",
"a "f.white"variable"f.black".", LineLen, Tab)
/* Is it a keyword? */
if CheckXR then
if word(getxref(resp),3) = 2 then do
say WordWrap('0a'x||f.white" "Resp f.black"is an "f.white"instruction keyword" f.black"in ARexx. (See" f.slant"Instruction",
"reference"f.norm "for more information.) Despite that, it is not",
"reserved and can be used as a"f.white "variable"f.black "in most situations.",,
LineLen, Tab)
end
if find('RESULT RC SIGL', Resp) > 0 then do
say WordWrap('0a'x" "f.white||Resp f.black"is one of three"f.white "special variables"f.black "used by the interpreter.",
"Although it can be assigned a value in a script, it is not wise",
"to use it that way since the interpreter might change its value.",,
LineLen, Tab)
end
end
when pos('.', Resp) > 0 then
select
when left(Resp, 1) = '.' then do
say WordWrap("Because of the period at the beginning, this is a "f.white"constant",
"symbol"f.black". It cannot be used as the target of an assignment.",
"The ANSI REXX committee has warned that symbols like this",
"might become invalid in the future.", LineLen, Tab)
end
when right(resp, 1) == '.' then
/* make sure there's not a second period in there */
if lastpos('.', Resp, length(Resp) - 1) = 0 & IsVar(resp) then do
say WordWrap("This is a `"f.white"stem symbol"f.black"'. It is used as the base upon which a",
f.white"compound variable"f.black "can be built, but it can also be used by",
"itself in an assignment. If it is, then all compound variables",
"built from this stem -- like"f.white resp"1"f.black "-- will be assigned",
"the same value as a default value.", LineLen, Tab)
end
else do
say WordWrap("This is a `"f.white"complex symbol"f.black"'. Note that it is not a" f.white"stem" f.black"because",
"it contains more that one `.' characters. Only the part of the",
"symbol before and including the first period --" f.white || left(resp, pos('.', resp))f.black "--",
"is a stem symbol.", LineLen, Tab)
end
when IsVar(resp) then do
parse var Resp stem '.' tail
say WordWrap("This is a `"f.white"complex symbol"f.black"'. The `"f.white||stem"."f.black"' part of the symbol",
"is called the `"f.white"stem"f.black"'. The rest of it, `"f.white||tail||f.black"', is called",
"the `"f.white"tail"f.black"'. If any simple symbol in the tail is assigned a",
"value, then that value is substituted when the variable",
"named by this symbol is evaluated in an expression.",,
LineLen,Tab)
end
otherwise
say " This is a" f.white"constant symbol"f.black". It cannot be assigned a value."
end
otherwise NOP
end
end
end
call remlib('amigaguide.library')
return 0
IsVar:
/* call trace b */
return symbol(arg(1)) ~== 'BAD' & (datatype(left(arg(1),1), m),
| verify(left(arg(1),1), '!$_@#', M))
WordWrap: procedure
/* Arguments: **
** Text := The string that is to be split into parts **
** Length := Maximum length of lines desired. **
** Tab := White space to add at start of line */
parse arg Text, Length, Tab
Line. = '' /* All compounds are now null */
EndPos = length(Text); DivPos = 1 /* Preliminary values for loop */
numeric digits
Length = Length - Tab /* shorten it to allow for the tab */
Line = ''; csi = '9b'x
do i = 1 while EndPos <= length(Text)
/* Get a rough count of control characters in the line */
FmtChar = CountChar(csi, substr(Text, DivPos, Length + 12))*4
EndPos = lastpos(' ',Text' ', DivPos + FmtChar + Length+1)
/* Handle a word that's bigger than the line length by **
** splitting it arbitrarily at the line length */
if EndPos < DivPos then do
EndPos = DivPos + Length - 1
Text = insert('- ', Text, EndPos-2)
end
Line = Line || copies(' ', Tab)substr(Text, DivPos, EndPos-DivPos)'0a'x
/* Add one to DivPos because we want to get rid of the space **
** at the start of each line. */
DivPos = EndPos + 1
end
return strip(Line,'t', '0a'x)
CountChar:
return length(arg(2)) - length(compress(arg(2), arg(1)))
/* $VER: 1.0 ShowSTDIO.rexx by Robin Evans (11 Jun 1993) */
ShowSTDIO: procedure expose f.
/* Demonstrate the effect of redirected IO. */
arg CLOSE
options failat 21 /* to retain control when an error occurs */
signal on ERROR
signal on SYNTAX
LFS = f.lf||f.white
do forever /* Loop allows reentering the demonstration */
say f.white||f.cls
say ' This demonstration will write a small ARexx file to the t:'
say ' directory.'
say
say ' That file will be called with various forms of' f.black'redirection'f.white
say ' to demonstrate the effect of redirection characters on '
say ' ARexx files.'f.norm
/* Save the demo file to the ram: disk T: directory */
TFName = 't:testIO.rexx'
TestCode = '/**/'f.lf'options prompt "0a"x||"Enter any text then press <Enter>: "'f.lf'pull T$'f.lf'say "0a"x||"You entered:" T$'f.lf
if open(TFile, TFName, w) then do
call writech(TFile, TestCode)
call close TFile
if QKey() then return 0
say LFS'The file has been written to the T: directory:'
call showSPrompt('list' left(TFName, 5)'#?')
call showSPrompt( 'type' TFname)
if QKey() then return 0
say f.lf LFS'We will now run that program. Enter some text when prompted:'
call showSPrompt('rx' TFname)
say LFS'Notice that the program output to the shell the text you entered.'
if QKey() then return 0
say LFS'We''ll run it again, but this time we''ll redirect output using'
say ' the DOS ">" redirection operator.'
call showSPrompt('rx' TFname '>T:IOutput')
say LFS'Notice that the program didn''t output anything this time, even'
say ' though the SAY instruction is still in the program.'
say ' What happened? Observe:'
call showSPrompt('type T:IOutput')
say LFS'Because of the redirection operator, the output of SAY went to a'
say ' file instead of to the screen.'
if QKey() then return 0
say LFS'What happens when both input and output are redirected?'
call showSPrompt('rx' TFname '<'TFName '>T:IOutput')
say LFS'There was no prompt this time because the PULL instruction was'
say ' redirected to look for its input from the file "'TFName'".'
say ' It pulled the first line from that file:'
call showSPrompt('type T:IOutput')
end
say f.lf||f.white||f.slant'This concludes the demonstration.'f.norm
say ' Press <'f.white||f.bold'Enter'f.norm'> to quit or <'f.white||f.bold'R'f.norm'> and <'f.white||f.bold'Enter'f.norm'> to repeat the demo.'
pull Rsp
if Rsp ~= 'R' then leave
end
return 0
QKey: procedure expose f.
options prompt f.lf||f.blue' Type <Q> and <Enter> to quit. Press <Enter> alone to continue.'f.norm
pull QKey
if QKEY = Q then return 1
else return 0
ShowSPrompt: procedure expose f.
address command
parse arg DCmd
call writech(STDOUT, f.lf||f.blue'Shell'f.white'> 'f.norm)
call delay(30)
say DCmd
""DCmd
return 0
DoBreak: procedure expose f.
/* Show how the break keys work in a subroutine */
signal off break_e
Say f.white" Press Control and E to stop the obnoxious listing that"
say " will follow this message."f.black
if QKey() then return
NumRepeats = AdInfinit()
say f.white||f.lf'The message was repeated' NumRepeats 'times.'
say f.lf'We have returned from a subroutine to the main code of'
say 'the program. The break key was detected within the subroutine'
say 'but control could still be returned to the main program.'
say f.lf||f.white' This demo is coded in the file' f.blue'ARx_IactExamples.rexx'
say f.white' in the subroutine' f.blue'DoBreak:'
say f.black||f.lf'- Press any key - '
pull .
return
/* The subroutine being called by SIGNAL can be anywhere in **
** program. PROCEDURE¤¤, used in AdInfinit blinds it to **
** variables in the main program, but still allows the **
** BREAK_E subroutine to retrieve the [Rep] variable. */
BREAK_E:
say f.blue'Break detected at line' SIGL':'
say f.white||sourceline(SIGL)
return Rep
AdInfinit: PROCEDURE expose f.
/* turning on the signal within the subroutine¤¤ means **
** it will be effective only while this subroutine is **
** active */
signal on break_e
do Rep = 1
say 'Press Ctrl-E at any time.'
call delay 25
say 'Stop me. Please.'
end
/* because the loop¤¤ above is endless, this RETURN¤¤ **
** will never be reached. */
return 0